COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY  COMMENT COMERR, GENLABEL, INITOUT, CLOSEOUT
C00006 00003	!  MAKE_REMARK, EMIT
C00010 ENDMK
C⊗;
ENTRY;  COMMENT COMERR, GENLABEL, INITOUT, CLOSEOUT;
BEGIN "emiter"

REQUIRE "ABBREV.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "EMITER.HDR[AL,HE]" SOURCE_FILE;

INTERNAL PROCEDURE COMERR
  (STRING MESSG;RECORD_POINTER(ANY_CLASS) CONTXT (NULL_RECORD));
    !  Non-fatal warnings;
    BEGIN
    EXTERNAL RECURSIVE PROCEDURE ALPRIN
     (RECORD_POINTER(ANY_CLASS) S);
    IF CONTXT≠NULL_RECORD THEN ALPRIN(CONTXT);
    USERERR(0,1,"HAH!  "&MESSG);
    END;

INTERNAL INTEGER PROCEDURE GENLABEL;
    BEGIN  ! Makes a new label for the PALX output;
    OWN INTEGER LAB;
    RETURN(LAB ← LAB + 1);
    END;

INTEGER REL0;  !  Channel number;
INTEGER REL1;  !  Channel number;
INTEGER REL2;  !  Channel number;
INTEGER REL3;  !  Channel number;
BOOLEAN SYM_FILE;	! If true generate a symbol file, else don't;

INTERNAL PROCEDURE INITOUT(STRING FNAME,PPN; BOOLEAN SF(TRUE));
    BEGIN "initout" ! Initialize the four output streams, going to the files
    FNAME.ALP, FNAME.ALT, FNAME.ALV, FNAME.ALS;
    INTEGER COUNT, BRCHAR, EOF, FLAG;
    REL0 ← GETCHAN;
    OPEN(REL0,"DSK",0,0,2,COUNT,BRCHAR,EOF);
    ENTER(REL0,FNAME&".ALP"&PPN,FLAG);
    IF FLAG THEN COMERR("I can't enter "&FNAME&".ALP");
    REL1 ← GETCHAN;
    OPEN(REL1,"DSK",0,0,2,COUNT,BRCHAR,EOF);
    ENTER(REL1,FNAME&".ALT"&PPN,FLAG);
    IF FLAG THEN COMERR("I can't enter "&FNAME&".ALT");
    REL2 ← GETCHAN;
    OPEN(REL2,"DSK",0,0,2,COUNT,BRCHAR,EOF);
    ENTER(REL2,FNAME&".ALV"&PPN,FLAG);
    IF FLAG THEN COMERR("I can't enter "&FNAME&".ALV");
    IF SF THEN
	BEGIN
	REL3 ← GETCHAN;
	OPEN(REL3,"DSK",0,0,2,COUNT,BRCHAR,EOF);
	ENTER(REL3,FNAME&".ALS"&PPN,FLAG);
	IF FLAG THEN COMERR("I can't enter "&FNAME&".ALS");
	SYM_FILE ← TRUE
	END
    ELSE SYM_FILE ← FALSE
    END "initout";

INTERNAL PROCEDURE CLOSEOUT;
    BEGIN  ! Close all channels;
    CLOSE(REL0);
    CLOSE(REL1);
    CLOSE(REL2);
    IF SYM_FILE THEN CLOSE(REL3);
    END;
!  MAKE_REMARK, EMIT;

STRING RSTRING;

INTERNAL PROCEDURE EMIT(INTEGER PC; REFERENCE INTEGER DATA, RELOC;
    INTEGER LTH (1));
    BEGIN "emit"
    !  Appends to current PAL files.  DATA and RELOC are the first
    words in a block of size LTH.  DATA holds the actual output, and
    RELOC holds relocation information about how to treat the word in
    DATA.  A record is kept of how many bytes have been stored for
    each PC;

    OWN INTEGER ARRAY WORDCOUNT [0:3];	!  How many words have been stored
	for this PC;

    INTEGER J, K, DAT, REL;
    EXTERNAL STRING ARRAY PSOP[1:300];
    IF PC = SYMFIL ∧ ¬SYM_FILE THEN RETURN;
    REL ← CASE PC OF (REL0, REL1, REL2, REL3);

    FOR J ← 0 STEP 1 UNTIL LTH-1 DO
	BEGIN "emitloop"
	DAT ← MEMORY[LOC(DATA) + J];
	CASE MEMORY[LOC(RELOC) + J] OF
	    BEGIN "case"
   [PSINST]	BEGIN "psinst"
		IF PC ≠ PSDCODE
		THEN COMERR("Outputting a pseudo-instruction, PC is not PSDCODE.");
		OUT(REL,TAB & PSOP[DAT] & CRLF);
		WORDCOUNT[PC] ← WORDCOUNT[PC] + 1;
		END "psinst";
   [SYMDEC]	OUT(REL,"L" & CVOS(DAT) & ":");
   [SYMREF]	BEGIN "symref"
		OUT(REL,(TAB & "L") & CVOS(DAT) & CRLF);
		WORDCOUNT[PC] ← WORDCOUNT[PC] + 1;
		END "symref";
   [REMARK]	OUT(REL,(TAB & TAB & ";") & RSTRING & CRLF);
   [SKIP]	BEGIN "skip"
		OUT(REL,(TAB & ".BLKW" & TAB) & CVOS(DAT) & CRLF);
		WORDCOUNT[PC] ← WORDCOUNT[PC] + DAT;
		END "skip";
   [CONST]	BEGIN "const"
		OUT(REL,TAB & CVOS(DAT LAND '177777) & CRLF);
		WORDCOUNT[PC] ← WORDCOUNT[PC] + 1;
		END "const";
   [FLOAT]	BEGIN "float"
		OUT(REL,TAB & ".FLT2" & TAB & CVF(MEM[LOC(DAT),REAL]) & CRLF);
		WORDCOUNT[PC] ← WORDCOUNT[PC] + 2;
		END "float";
   [STRCONST]	BEGIN "strconst"
		!  DAT is the location of a string constant;
		STRING STR;
		MEMLOC(STR,INTEGER) ← DAT;
		MEMLOC(STR,INTEGER) ← MEM[DAT,INTEGER];
		MEM[LOC(STR)-1,INTEGER] ← MEM[DAT-1,INTEGER];
		OUT(REL,TAB & "ASCIE ↑∀" & STR & "∀" & CRLF);
		WORDCOUNT[PC] ← WORDCOUNT[PC] + (LENGTH(STR)+1) DIV 2;
		END "strconst"
	    END "case";
	END "emitloop";
    END "emit";

INTERNAL PROCEDURE MAKE_REMARK(INTEGER PC;STRING REMK);
    BEGIN "make_remark"  !  Outputs this remark to the PAL file;
    RSTRING ← REMK;
    EMIT(PC,0,REMARK);
    END "make_remark";

END "emiter";